#|
 |
 | ViSta - The Visual Statistics System
 | Copyright (c) 1991-2000 by Forrest W. Young
 | For further information contact the author 
 | forrest@unc.edu or http://forrest.psych.unc.edu
 |
 | This file contains code for the hyperlog object
 |
 | ARGUMENT  VALUE    EFFECT
 | FIRST       t      FIRST  button first function in series
 | BACK        t      BACK   button does previous function
 |           '(f)     BACK   button does function f
 | NEXT      '(f)     NEXT   button does function f
 | FINISH    '(f)     FINISH button does finish function f
 | EXIT        t      EXIT   button does exit function
 | HELP      '(f)     HELP   button does help function f
 | INFO       nil     no button, turns info off
 |          omitted   previous INFO button when info on, no button when off 
 |           '(f)     INFO button does help function f, turns info on
 | LAYOUT  list nest  layout for buttons. button symbols may be used
 | TITLE
 | HEADER
 | DIVIDER
 | FOOTER
 |#

(setf *current-hyperlog* nil)

;using the global variable *current-hyperlog* is necessary so that
;each hyper-dialog knows who first, previous and last are
;has side-effect that cannot nest hyperlogs



#|
 | constructor functions
 |#


(defmacro hyper-dialog (&rest args)
  (setf *current-hyperlog* (send hyperlog-supervisor-proto :new args))
  (send *current-hyperlog* :run-hyperlog)
  )

(defun button-hyper-dialog (button-list &key button-text (text nil) (links nil)
        (title "Choice Hyper-Dialog") (header "Choice Hyper-Dialog") (divider nil)
        (footer nil)
        (first nil) (back nil) (previous nil) (next nil) (finish nil) (exit nil) 
        (help nil) (info nil) (big-help nil) (big-info nil) (action nil) (layout nil))
  (send hyper-dialog-proto :new :button-list button-list :button-text button-text
        :title title :header header :footer footer :layout layout :action action
        :first first :back back :next next :finish finish :exit exit :link-list links
        :help help :info info :big-help big-help :big-info big-info :text text
        :divider divider :supervisor *current-hyperlog*))

(defun choice-hyper-dialog (choice-text  choice-list 
   &key (title "Choice Hyper-Dialog") (header "Choice Hyper-Dialog") 
               (footer nil) (divider nil) (next-in-body nil)
        (first nil) (back nil) (previous nil) (next nil) (finish nil) (exit nil) 
        (help nil) (info nil) (big-help nil) (big-info nil) (action nil) (layout nil)
        (next-in-body nil))
  (send hyper-dialog-proto :new :choice-text choice-text :choice-list choice-list
        :title title :header header :footer footer :layout layout :action action
        :first first :back back :next next :finish finish :exit exit 
        :next-in-body next-in-body
        :help help :info info :big-help big-help :big-info big-info
        :divider divider :supervisor *current-hyperlog*))

(defun text-hyper-dialog (text
   &key (title "Text Hyper-Dialog") (header "Text Hyper-Dialog") 
                          (footer nil)(divider nil)
        (first nil) (back nil) (next nil) (finish nil) (exit nil) 
        (help nil) (info nil) (layout nil) (big-help nil) (big-info nil)
        (next-in-body nil))
  (send hyper-dialog-proto :new :text text :action nil
        :title title :header header :footer footer :layout layout
        :first first :back back :next next :finish finish :exit exit
        :next-in-body next-in-body 
        :help help :info info  :big-help big-help :big-info big-info
        :divider divider :supervisor *current-hyperlog*))


(defun edit-text-hyper-dialog (text
   &key (title "Edit Text Hyper-Dialog") (header "Edit Text Hyper-Dialog") 
        (footer nil) (divider nil)
        (first nil) (back nil) (previous nil) (next nil) (finish nil) (exit nil) 
        (help nil) (info nil) (big-help nil) (big-info nil) (action nil) (layout nil)
        (next-in-body nil))
  (send hyper-dialog-proto :new :edit-text text :action action
        :title title :header header :footer footer :layout layout
        :first first :back back :next next :finish finish :exit exit 
        :next-in-body next-in-body :divider divider
        :help help :info info  :big-help big-help :big-info big-info
        :supervisor *current-hyperlog*))


(defun hyper-dialog-box 
  (&key (text nil) 
        (edit-text nil)
        (title "Hyper-Dialog") (header "Hyper-Dialog") 
        (footer nil) (divider nil) (button-list nil) (button-text nil)
        (choice-text nil)(choice-list nil) (action nil) (links nil)
        (first nil) (back nil) (previous nil) (next nil) (finish nil) (exit nil) 
        (help nil) (info nil) (big-help nil) (big-info nil) (action nil) (layout nil)
        (next-in-body nil))
  (send hyper-dialog-proto :new :text text :edit-text text :action action
        :title title :header header :footer footer :layout layout
        :first first :back back :next next :finish finish :exit exit 
        :next-in-body next-in-body :divider divider 
        :button-list button-list :button-text button-text
        :help help :info info  :big-help big-help :big-info big-info
        :supervisor *current-hyperlog*))

#|
 | hyperlog-supervisor-proto 
 |#

(defproto hyperlog-supervisor-proto '(first next previous last all-hyper-dialogs))

(defmeth hyperlog-supervisor-proto :isnew (hyper-dialog-list)
"puts all hyper-dialog creator functions in the all-hyper-dialogs slot
and initializes first previous and last slots"
  (send self :all-hyper-dialogs hyper-dialog-list)
  (send self :first (eval (first hyper-dialog-list)))
  (send self :previous (eval (first hyper-dialog-list)))
  (send self :last (eval (first (last hyper-dialog-list))))
  )  

(defmeth hyperlog-supervisor-proto :run-hyperlog ()
  (let* ((dialog-creators (send self :all-hyper-dialogs)))
    (mapcar #'(lambda (creator-function)
                (eval creator-function))
            dialog-creators)
    (eval (funcall (send self :first)))))

(defmeth hyperlog-supervisor-proto :first (&optional (object nil set))
  (if set (setf (slot-value 'first) object))
  (slot-value 'first))

(defmeth hyperlog-supervisor-proto :next (&optional (object nil set))
  (if set (setf (slot-value 'next) object))
  (slot-value 'next))

(defmeth hyperlog-supervisor-proto :previous (&optional (object nil set))
  (if set (setf (slot-value 'previous) object))
  (slot-value 'previous))

(defmeth hyperlog-supervisor-proto :last (&optional (object nil set))
  (if set (setf (slot-value 'last) object))
  (slot-value 'last))

(defmeth hyperlog-supervisor-proto :all-hyper-dialogs (&optional (list nil set))
  (if set (setf (slot-value 'all-hyper-dialogs) list))
  (slot-value 'all-hyper-dialogs))
  


                                    
#|
 | hyper-dialog-proto
 |#


(defproto hyper-dialog-proto 
  '(supervisor title header footer button-list button-text link-list  
    choice-text choice-list edit-text text edit-text-item edited-text action-list 
               divider next-in-body
    first back previous next finish last exit big-help big-info help info layout  
    first-button back-button next-button finish-button last-button exit-button 
    help-button info-button choice-item choice-number) 
  () dialog-proto)

(defmeth hyper-dialog-proto :isnew 
  (&key button-list button-text choice-text choice-list text edit-text action
        title header footer layout supervisor link-list divider next-in-body
        first back next finish exit help info big-help big-info)
  (send self :supervisor supervisor)
  (send self :button-list button-list)
  (send self :button-text button-text)
  (send self :choice-text choice-text)
  (send self :choice-list choice-list)
  (send self :text text)
  (send self :edit-text edit-text)
  (send self :title title)
  (send self :header header) 
  (send self :divider divider)
  (send self :footer footer)
  (send self :layout (list layout))
  (send self :first first)
  (send self :back back)
  (send self :next next)
  (send self :next-in-body next-in-body)
  (send self :finish finish)
  (send self :exit exit)
  (send self :help help)
  (send self :info info)
  (send self :link-list link-list)
  (send self :big-help big-help)
  (send self :big-info big-info)
  (send self :action-list action)
  (send self :first-button (not (not first)))
  (send self :back-button  (not (not back)))
  (send self :next-button  (not (not next)))
  (send self :exit-button  (not (not exit))) 
  (send self :finish-button (not (not finish)))
  (send self :help-button  (or (not (not big-help)) (not (not help))))
  (send self :info-button  (or (not (not big-info)) (not (not info))))
  (when (and action choice-text)
        (unless (= (length choice-list) (length action) (length next))
                (error-message "The number of choices, actions and nexts must all be the same")))
  (send self :make-dialog)
  )


(defmeth hyper-dialog-proto :supervisor (&optional (objid nil set))
  (if set (setf (slot-value 'supervisor) objid))
  (slot-value 'supervisor))

(defmeth hyper-dialog-proto :title (&optional (string nil set))
  (if set (setf (slot-value 'title) string))
  (slot-value 'title))

(defmeth hyper-dialog-proto :header (&optional (string nil set))
  (if set (setf (slot-value 'header ) string))
  (slot-value 'header))

(defmeth hyper-dialog-proto :divider (&optional (string nil set))
  (if set (setf (slot-value 'divider ) string))
  (slot-value 'divider))

(defmeth hyper-dialog-proto :button-list (&optional (list nil set))
  (if set (setf (slot-value 'button-list ) list))
  (slot-value 'button-list ))

(defmeth hyper-dialog-proto :button-text (&optional (string nil set))
  (if set (setf (slot-value 'button-text) string))
  (slot-value 'button-text))

(defmeth hyper-dialog-proto :choice-text (&optional (string nil set))
  (if set (setf (slot-value 'choice-text) string))
  (slot-value 'choice-text))

(defmeth hyper-dialog-proto :choice-list (&optional (list nil set))
  (if set (setf (slot-value 'choice-list ) list))
  (slot-value 'choice-list ))

(defmeth hyper-dialog-proto :link-list (&optional (list nil set))
  (if set (setf (slot-value 'link-list ) list))
  (slot-value 'link-list ))

(defmeth hyper-dialog-proto :action-list (&optional (list nil set))
  (if set (setf (slot-value 'action-list ) list))
  (slot-value 'action-list ))


(defmeth hyper-dialog-proto :action ())


(defmeth hyper-dialog-proto :edit-text-item (&optional (object nil set))
  (if set (setf (slot-value 'edit-text-item ) object))
  (slot-value 'edit-text-item))

(defmeth hyper-dialog-proto :edit-text (&optional (string nil set))
  (if set (setf (slot-value 'edit-text ) string))
  (slot-value 'edit-text ))


(defmeth hyper-dialog-proto :edited-text (&optional (string nil set))
  (if set (setf (slot-value 'edited-text ) string))
  (slot-value 'edited-text ))

(defmeth hyper-dialog-proto :text (&optional (string nil set))
  (if set (setf (slot-value 'text ) string))
  (slot-value 'text ))

(defmeth hyper-dialog-proto :footer (&optional (string nil set))
  (if set (setf (slot-value 'footer) string))
  (slot-value 'footer))

(defmeth hyper-dialog-proto :first (&optional (objid nil set))
  (if set (setf (slot-value 'first) objid))
  (slot-value 'first))

(defmeth hyper-dialog-proto :back (&optional (objid nil set))
  (if set (setf (slot-value 'back) objid))
  (slot-value 'back))

(defmeth hyper-dialog-proto :previous (&optional (objid nil set))
  (if set (setf (slot-value 'previous) objid))
  (slot-value 'previous))

(defmeth hyper-dialog-proto :next (&optional (objid nil set))
  (if set (setf (slot-value 'next) objid))
  (slot-value 'next))

(defmeth hyper-dialog-proto :finish (&optional (objid nil set))
  (if set (setf (slot-value 'finish) objid))
  (slot-value 'finish))

(defmeth hyper-dialog-proto :last (&optional (objid nil set))
  (if set (setf (slot-value 'last) objid))
  (slot-value 'last))

(defmeth hyper-dialog-proto :exit (&optional (objid nil set))
  (if set (setf (slot-value 'exit) objid))
  (slot-value 'exit))

(defmeth hyper-dialog-proto :help (&optional (objid nil set))
  (if set (setf (slot-value 'help) objid))
  (slot-value 'help))

(defmeth hyper-dialog-proto :info (&optional (objid nil set))
  (if set (setf (slot-value 'info) objid))
  (slot-value 'info))

(defmeth hyper-dialog-proto :big-help (&optional (nilt nil set))
  (if set (setf (slot-value 'big-help) nilt))
  (slot-value 'big-help))

(defmeth hyper-dialog-proto :big-info (&optional (nilt nil set))
  (if set (setf (slot-value 'big-info) nilt))
  (slot-value 'big-info))
    
(defmeth hyper-dialog-proto :first-button (&optional (nilt nil set))
  (if set (setf (slot-value 'first-button) nilt))
  (slot-value 'first-button))

(defmeth hyper-dialog-proto :back-button (&optional (nilt nil set))
  (if set (setf (slot-value 'back-button) nilt))
  (slot-value 'back-button))

(defmeth hyper-dialog-proto :next-button (&optional (nilt nil set))
  (if set (setf (slot-value 'next-button) nilt))
  (slot-value 'next-button))

(defmeth hyper-dialog-proto :last-button (&optional (nilt nil set))
  (if set (setf (slot-value 'last-button) nilt))
  (slot-value 'last-button))

(defmeth hyper-dialog-proto :exit-button (&optional (nilt nil set))
  (if set (setf (slot-value 'exit-button) nilt))
  (slot-value 'exit-button))

(defmeth hyper-dialog-proto :finish-button (&optional (nilt nil set))
  (if set (setf (slot-value 'finish-button) nilt))
  (slot-value 'finish-button))

(defmeth hyper-dialog-proto :help-button (&optional (nilt nil set))
  (if set (setf (slot-value 'help-button) nilt))
  (slot-value 'help-button))

(defmeth hyper-dialog-proto :info-button (&optional (nilt nil set))
  (if set (setf (slot-value 'info-button) nilt))
  (slot-value 'info-button))

(defmeth hyper-dialog-proto :result (&optional (value nil set))
  (if set (setf (slot-value 'result) value))
  (slot-value 'result))

(defmeth hyper-dialog-proto :choice-number (&optional (value nil set))
  (if set (setf (slot-value 'choice-number) value))
  (slot-value 'choice-number))

(defmeth hyper-dialog-proto :choice-item (&optional (objid nil set))
  (if set (setf (slot-value 'choice-item) objid))
  (slot-value 'choice-item))

(defmeth hyper-dialog-proto :layout (&optional (list-nest nil set))
  (if set (setf (slot-value 'layout) list-nest))
  (slot-value 'layout))

(defmeth hyper-dialog-proto :next-in-body (&optional (list-nest nil set))
  (if set (setf (slot-value 'next-in-body) list-nest))
  (slot-value 'next-in-body))


(defmeth hyper-dialog-proto :make-dialog (&key (size '(430 300)))
  (let* ((hyperlog self)
         (header  (if (send self :header) 
                      (send text-item-proto :new 
                            (string-upcase (send self :header)))))
         (text (if (send self :text)  
                   (list
                    (send text-item-proto :new "  ")
                    (send text-item-proto :new (send self :text)))))
         (body    (remove nil (send self :make-body-item)))
         (body-buttons (if (send self :button-list)
                           (remove nil (mapcar #'(lambda (item) 
                                                   (when (objectp item)
                                                         item))
                                               (combine body)))))
         (divider (send self :divider))
         (divider-item (send text-item-proto :new 
                             (if divider divider
         "_______________________________________________________________")
                                 :location (list 10 (- (second size) 100))))
         (button-layout (send self :hyper-buttons body-buttons))
         (next-in-body (send self :next-in-body))
         (leading-next (if next-in-body (first button-layout)))
         (button-layout (if next-in-body (second button-layout) button-layout))
         (footer  (if (send self :footer) 
                      (send text-item-proto :new (send self :footer))))

         (dialog      (send dialog-proto :new
                            (remove nil 
                                    (list header
                                          text
                                          (if next-in-body
                                              (list leading-next (list body))
                                              body)
                                          divider-item
                                          button-layout
                                          footer))
                            :size size
                            :title (send self :title)))
         )
    
    (mapcar #'(lambda (button)
                (send button :dialog dialog)
                (when (equal (send button :type) 'exit)
                      (defmeth button :do-action ()
                        (when (ok-or-cancel-dialog 
                               "Do You Really Wish to Exit?"
                               :title "Exit?")
                              (send dialog :remove)
                              (exit))
                        )
                      ))
                (combine button-layout))
    (defmeth dialog :close ())
    dialog))


(defmeth hyper-dialog-proto :make-body-item ()
  (let* ((button-list (send self :button-list))
         (choice-text (send self :choice-text))
         (choice-list (send self :choice-list))
         (button-text (send self :button-text))
         (action-list (send self :action-list))
         (link-list   (send self :link-list))
         (spacer (send text-item-proto :new " "))
         (next-in-body (send self :next-in-body))
         (text (send self :text))
         (edit-text (send self :edit-text))
         (edit-text-item)
         (choice-item (if choice-text 
                          (send choice-item-proto :new choice-list) 
                          nil))
         (body-item))
    (setf body-item
          (cond
            (button-list
             (list (mapcar #'(lambda (button text link)
                               (let ((but (send hyper-button-item-proto 
                                                :new   button
                                                :type 'wild
                                                :link 'link)))
                               
                                 (list but text)))
                           button-list button-text link-list)))
            (choice-text
             (send self :choice-item choice-item)
             (list (list (send text-item-proto :new choice-text)
                         (if next-in-body
                             choice-item
                             (list spacer choice-item)))))
           ; (text        
           ;  (list (send text-item-proto :new "  ")
           ;        (list (send text-item-proto      :new text))))
            (edit-text   
             (setf edit-text-item (send edit-text-item-proto :new edit-text))
             (send self :edit-text-item edit-text-item)
             (list (send text-item-proto :new "  ") (list edit-text-item))
             )))
    body-item))

(defmeth hyper-dialog-proto :hyper-buttons (body-buts)
  (let* ((hyperlog self)
         (first (send self :first-button))
         (back (send self :back-button))
         (next (send self :next-button))
         (exit (send self :exit-button))
         (finish (send self :finish-button))
         (help (send self :help-button))
         (info (send self :info-button))
         (big-help (send self :big-help))
         (big-info (send self :big-info))
         (action-list (send self :action-list))
         (link-list (send self :link-list))
         (next-in-body (send self :next-in-body))
         (first-but (if first 
                       (send hyper-button-item-proto :new   
                             "|<  First" :type 'first)))
         (back-but  (if back  
                       (send hyper-button-item-proto 
                             :new   "<  Back"   
                             :hyper-dialog hyperlog
                             :type 'back)))
         (next-but  (if next  
                       (send hyper-button-item-proto 
                             :new  (if next-in-body "NEXT" "Next >")
                             :type 'next
                             )))
         (finish-but (if finish 
                       (send hyper-button-item-proto 
                             :new "Finish"
                             :hyper-dialog hyperlog
                             :type 'finish)))
         (exit-but (if exit   
                       (send hyper-button-item-proto  
                             :new "Exit  >|"
                             :hyper-dialog hyperlog
                             :type 'exit)))
         (help-but (if help   
                       (send hyper-button-item-proto 
                             :new (if big-help "     ??  Help  ??      " "?? Help ??" )
                             :hyper-dialog hyperlog
                             :type (if big-help 'big-help 'help)
                             :big big-help
                             :action (if big-help
                                         #'(lambda () (eval (send hyperlog :big-help)))
                                         #'(lambda () (eval (send hyperlog :help)))))))
         (info-but (if info  
                       (send hyper-button-item-proto 
                             :new (if big-info "    ! !  Info  ! !      " "! ! Info ! !")
                             :hyper-dialog hyperlog
                             :big big-info
                             :type (if big-info 'big-info 'info)
                             :action (if big-info
                                         #'(lambda () (eval (send hyperlog :big-info)))
                                         #'(lambda () (eval (send hyperlog :info)))))))
         )
    (when body-buts
          (mapcar #'(lambda (body-but action link)
                      (defmeth body-but :do-action ()
                        (send (send self :dialog) :remove)
                        (send body-but :hyper-dialog hyperlog)
                        (eval (eval action))
                        (eval (eval link)))
                      )
                  body-buts action-list link-list))
    (when next-but
          (defmeth next-but :do-action ()
            
            (send next-but :hyper-dialog hyperlog)
            (send hyperlog :action-list)
            (cond 
              ((send hyperlog :choice-text)
               (send hyperlog :choice-number 
                     (send (send hyperlog :choice-item) :value)))
              ((send hyperlog :text)
               (send hyperlog :choice-number 0))
              ((send hyperlog :edit-text)
               (send hyperlog :edited-text
                     (send (send (send self :hyper-dialog) :edit-text-item) :text))
               (send hyperlog :choice-number 0)))
            (when (send hyperlog :action-list)
                  (eval (select (send hyperlog :action-list)
                                (send hyperlog :choice-number))))
            ;(funcall (send hyperlog :action))
            (let* ((supervisor (send hyperlog :supervisor))
                   (next-function 
                    (select (send hyperlog :next) (send hyperlog :choice-number))))
              (send supervisor :previous  (send supervisor :next))
              (send supervisor :next next-function)
              (eval (eval next-function)))
            (send (send self :dialog) :remove)))
    (when finish-but
          (defmeth finish-but :do-action ()
            (send (send self :dialog) :remove)
            (eval (eval (send hyperlog :finish)))))
    (when back-but
          (defmeth back-but :do-action ()
            (send (send self :dialog) :remove)
            (cond
              ((equal (send hyperlog :back) t)
               (eval (eval (send (send hyperlog :supervisor) :previous))))
              (t
               (eval (eval (send hyperlog :back)))))))
    (when first-but
          (defmeth first-but :do-action ()
            (send (send self :dialog) :remove)
            (eval (funcall (send (send hyperlog :supervisor) :first)))))
    (let* ((layout (send self :layout-the-buttons
                         (send self :layout)
                         (remove nil 
                                 (if next-in-body
                                     (remove nil 
                                             (list first-but back-but finish-but 
                                                   exit-but help-but info-but))
                                     (remove nil
                                             (list first-but back-but next-but 
                                                   finish-but exit-but help-but
                                                   info-but)))))))
      (if (and next next-in-body)
          (remove nil (list next-but layout))
          layout))
    ))

(defmeth hyper-dialog-proto :layout-the-buttons (types-lol list)
  (let ((n (length types-lol))
        (types-list (mapcar #'(lambda (but) (send but :type)) list))
        (element)
        )
    (dotimes (i n)
             (setf element (select types-lol i))
             (cond
               ((listp element)
                (send self :layout-the-buttons element list))
               ((symbolp element)
                (setf loc (position element types-list))
                (set element (select list loc))
                (setf (select types-lol i) (eval element))
                )
               (t
                (error "impossible branch"))))
    types-lol))



#|
 | hyper-model-button-proto 
 |#

(defproto hyper-modal-button-proto  
  '(hyper-dialog dialog type big) () modal-button-proto)

(defmeth hyper-modal-button-proto :type (&optional (symbol nil set))
  (if set (setf (slot-value 'type) symbol))
  (slot-value 'type))

(defmeth hyper-modal-button-proto :big (&optional (symbol nil set))
  (if set (setf (slot-value 'big) symbol))
  (slot-value 'big))

(defmeth hyper-modal-button-proto :dialog (&optional (objid nil set))
  (if set (setf (slot-value 'dialog) objid))
  (slot-value 'dialog))

(defmeth hyper-modal-button-proto :hyper-dialog (&optional (objid nil set))
  (if set (setf (slot-value 'hyper-dialog) objid))
  (slot-value 'hyper-dialog))

(defmeth hyper-modal-button-proto :isnew 
         (name &key (action nil) (type nil) (big nil) 
               (dialog nil) (hyper-dialog nil))
  (send self :dialog dialog)
  (send self :hyper-dialog hyper-dialog)
  (send self :type type)
  (send self :big big)
  (call-next-method name :action action))
  

  

#|
 | hyper-button-item-proto
 |#

(defproto hyper-button-item-proto
  '(hyper-dialog dialog type big) () button-item-proto)

(defmeth hyper-button-item-proto :type (&optional (symbol nil set))
  (if set (setf (slot-value 'type) symbol))
  (slot-value 'type))

(defmeth hyper-button-item-proto :big (&optional (symbol nil set))
  (if set (setf (slot-value 'big) symbol))
  (slot-value 'big))

(defmeth hyper-button-item-proto :dialog (&optional (symbol nil set))
  (if set (setf (slot-value 'dialog) symbol))
  (slot-value 'dialog))

(defmeth hyper-button-item-proto :hyper-dialog (&optional (objid nil set))
  (if set (setf (slot-value 'hyper-dialog) objid))
  (slot-value 'hyper-dialog))

(defmeth hyper-button-item-proto :isnew 
         (name &key (action nil) (type nil) (big nil) 
               (dialog nil) (hyper-dialog nil))
  (send self :dialog dialog)
  (send self :hyper-dialog hyper-dialog)
  (send self :type type)
  (send self :big big)
  (call-next-method name :action action))
  


#|
(defmeth choice-hyperlog-proto :get-user-type-help ()
  (message-dialog (format nil 
"This dialog controls access to certain ViSta features~%which can permanently modify the user's environment.~2%Choice 1: JUST ONE USER of a locally Installed ViSta~%has full access to all features. Modifications~%to ViSta's environment are saved between sessions.~2%Choice 2: SEVERAL USERS of either a locally or a~%remotely installed ViSta have limited access to~%features which modify ViSta's user environment.~%Additionally, these users cannot save changes between~%sessions. They can only write to the User Directory,~%which is specified later in the installation.~2%"))) 
|#